perm filename COALES.LSP[F80,JMC] blob sn#552600 filedate 1980-12-19 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 coales.lsp[f80,jmc]	program for coalescing list structures
C00004 ENDMK
CāŠ—;
;;; coales.lsp[f80,jmc]	program for coalescing list structures
;;; this program is taken from an exercise in Winston and Horn
;;; See coales[f80,jmc] for a discussion of its specification

(defun coalesce (u) (if
		     (null u)
		     nil
		     (merge (car u) (coalesce (cdr u)))))

(defun merge (v u) (if
		    (null u)
		    (list v)
		    (intersects v (car u))
		    (merge (merge1 v (car u)) (cdr u))
		    (cons (car u) (merge v (cdr u)))))

(defun intersects (v w) (and
			 (not (null v))
			 (or (member (car v) w) (intersects (cdr v) w))))

(defun merge1 (v w) (if
		     (null v)
		     w
		     (member (car v) w)
		     (merge1 (cdr v) w)
		     (cons (car v) (merge1 (cdr v) w))))

(print (setq t1 (coalesce '((A B) (A C) (D E F) (E G H)))))